home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / kolekce / d6 / rxlibsetup.exe / {app} / units / ANIFILE.PAS next >
Encoding:
Pascal/Delphi Source File  |  2002-02-19  |  18.6 KB  |  671 lines

  1. {*******************************************************}
  2. {                                                       }
  3. {         Delphi VCL Extensions (RX)                    }
  4. {                                                       }
  5. {         Copyright (c) 2001,2002 SGB Software          }
  6. {         Copyright (c) 1997, 1998 Fedor Koshevnikov,   }
  7. {                        Igor Pavluk and Serge Korolev  }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit AniFile;
  12.  
  13. {$I RX.INC}
  14.  
  15. interface
  16.  
  17. uses SysUtils, Windows, RTLConsts, Classes, Graphics;
  18.  
  19. type
  20.   TFourCC = array[0..3] of Char;
  21.  
  22.   PAniTag = ^TAniTag;
  23.   TAniTag = packed record
  24.     ckID: TFourCC;
  25.     ckSize: Longint;
  26.   end;
  27.  
  28.   TAniHeader = packed record
  29.     cbSizeOf: Longint;
  30.     cSteps: Longint;
  31.     cFrames: Longint;
  32.     cReserved: array[0..3] of Longint;
  33.     jifRate: Longint; { 1 Jiffy = 1/60 sec }
  34.     fl: Longint;
  35.   end;
  36.  
  37. const
  38.   AF_ICON     = $00000001;
  39.   AF_SEQUENCE = $00000002;
  40.  
  41. { TIconFrame }
  42.  
  43. type
  44.   TIconFrame = class(TPersistent)
  45.   private
  46.     FIcon: TIcon;
  47.     FIsIcon: Boolean;
  48.     FTag: TAniTag;
  49.     FHotSpot: TPoint;
  50.     FJiffRate: Longint;
  51.     FSeq: Integer;
  52.   public
  53.     constructor Create(Index: Integer; Jiff: Longint);
  54.     destructor Destroy; override;
  55.     procedure Assign(Source: TPersistent); override;
  56.     property JiffRate: Longint read FJiffRate;
  57.     property Seq: Integer read FSeq;
  58.   end;
  59.  
  60. { TAnimatedCursorImage }
  61.  
  62.   TANINAME = array[0..255] of Char;
  63.  
  64.   TAnimatedCursorImage = class(TPersistent)
  65.   private
  66.     FHeader: TAniHeader;
  67.     FTitle: TANINAME;
  68.     FCreator: TANINAME;
  69.     FIcons: TList;
  70.     FOriginalColors: Word;
  71.     procedure NewImage;
  72.     procedure RiffReadError;
  73.     function ReadCreateIcon(Stream: TStream; ASize: Longint;
  74.       var HotSpot: TPoint; var IsIcon: Boolean): TIcon;
  75.     function GetIconCount: Integer;
  76.     function GetIcon(Index: Integer): TIcon;
  77.     function GetFrame(Index: Integer): TIconFrame;
  78.     function GetTitle: string;
  79.     function GetCreator: string;
  80.     function GetDefaultRate: Longint;
  81.     procedure ReadAniStream(Stream: TStream);
  82.     procedure ReadStream(Size: Longint; Stream: TStream);
  83.     procedure WriteStream(Stream: TStream; WriteSize: Boolean);
  84.   protected
  85.     procedure AssignTo(Dest: TPersistent); override;
  86.     procedure Draw(ACanvas: TCanvas; const ARect: TRect);
  87.   public
  88.     constructor Create;
  89.     destructor Destroy; override;
  90.     procedure Assign(Source: TPersistent); override;
  91.     procedure Clear;
  92.     procedure LoadFromStream(Stream: TStream); virtual;
  93.     procedure SaveToStream(Stream: TStream); virtual;
  94.     procedure LoadFromFile(const Filename: string); virtual;
  95.     procedure AssignToBitmap(Bitmap: TBitmap; BackColor: TColor;
  96.       DecreaseColors, Vertical: Boolean);
  97.     property DefaultRate: Longint read GetDefaultRate;
  98.     property IconCount: Integer read GetIconCount;
  99.     property Icons[Index: Integer]: TIcon read GetIcon;
  100.     property Frames[Index: Integer]: TIconFrame read GetFrame;
  101.     property Title: string read GetTitle;
  102.     property Creator: string read GetCreator;
  103.     property OriginalColors: Word read FOriginalColors;
  104.   end;
  105.  
  106. implementation
  107.  
  108. { This implementation based on animated cursor editor source code
  109.   (ANIEDIT.C, copyright (C) Microsoft Corp., 1993-1996) }
  110.  
  111. uses Consts, VCLUtils, MaxMin, RxGraph, IcoList, ClipIcon;
  112.  
  113. const
  114.   FOURCC_ACON = 'ACON';
  115.   FOURCC_RIFF = 'RIFF';
  116.   FOURCC_INFO = 'INFO';
  117.   FOURCC_INAM = 'INAM';
  118.   FOURCC_IART = 'IART';
  119.   FOURCC_LIST = 'LIST';
  120.   FOURCC_anih = 'anih';
  121.   FOURCC_rate = 'rate';
  122.   FOURCC_seq  = 'seq ';
  123.   FOURCC_fram = 'fram';
  124.   FOURCC_icon = 'icon';
  125.  
  126. function PadUp(Value: Longint): Longint;
  127.   { Up Value to nearest word boundary }
  128. begin
  129.   Result := Value + (Value mod 2);
  130. end;
  131.  
  132. procedure DecreaseBMPColors(Bmp: TBitmap; Colors: Integer);
  133. var
  134.   Stream: TStream;
  135. begin
  136.   if (Bmp <> nil) and (Colors > 0) then begin
  137.     Stream := BitmapToMemory(Bmp, Colors);
  138.     try
  139.       Bmp.LoadFromStream(Stream);
  140.     finally
  141.       Stream.Free;
  142.     end;
  143.   end;
  144. end;
  145.  
  146. function GetDInColors(BitCount: Word): Integer;
  147. begin
  148.   case BitCount of
  149.     1, 4, 8: Result := 1 shl BitCount;
  150.     else Result := 0;
  151.   end;
  152. end;
  153.  
  154. { ReadTag, ReadChunk, SkipChunk. Some handy functions for reading RIFF files. }
  155.  
  156. function ReadTag(S: TStream; pTag: PAniTag): Boolean;
  157. begin
  158.   pTag^.ckID := #0#0#0#0;
  159.   pTag^.ckSize := 0;
  160.   Result := S.Read(pTag^, SizeOf(TAniTag)) = SizeOf(TAniTag);
  161. end;
  162.  
  163. function ReadChunk(S: TStream; pTag: PAniTag; Data: Pointer): Boolean;
  164. begin
  165.   Result := S.Read(Data^, pTag^.ckSize) = pTag^.ckSize;
  166.   if Result then
  167.     Result := S.Seek(pTag^.ckSize mod 2, soFromCurrent) <> -1;
  168. end;
  169.  
  170. function ReadChunkN(S: TStream; pTag: PAniTag; Data: Pointer;
  171.   cbMax: Longint): Boolean;
  172. var
  173.   cbRead: Longint;
  174. begin
  175.   cbRead := pTag^.ckSize;
  176.   if cbMax < cbRead then cbRead := cbMax;
  177.   Result := S.Read(Data^, cbRead) = cbRead;
  178.   if Result then begin
  179.     cbRead := PadUp(pTag^.ckSize) - cbRead;
  180.     Result := S.Seek(cbRead, soFromCurrent) <> -1;
  181.   end;
  182. end;
  183.  
  184. function SkipChunk(S: TStream; pTag: PAniTag): Boolean;
  185. begin
  186.   { Round pTag^.ckSize up to nearest word boundary to maintain alignment }
  187.   Result := S.Seek(PadUp(pTag^.ckSize), soFromCurrent) <> -1;
  188. end;
  189.  
  190. { Icon and cursor types }
  191.  
  192. const
  193.   rc3_StockIcon = 0;
  194.   rc3_Icon = 1;
  195.   rc3_Cursor = 2;
  196.  
  197. type
  198.   PCursorOrIcon = ^TCursorOrIcon;
  199.   TCursorOrIcon = packed record
  200.     Reserved: Word;
  201.     wType: Word;
  202.     Count: Word;
  203.   end;
  204.  
  205.   PIconRec = ^TIconRec;
  206.   TIconRec = packed record
  207.     Width: Byte;
  208.     Height: Byte;
  209.     Colors: Word;
  210.     xHotspot: Word;
  211.     yHotspot: Word;
  212.     DIBSize: Longint;
  213.     DIBOffset: Longint;
  214.   end;
  215.  
  216. { TIconFrame }
  217.  
  218. constructor TIconFrame.Create(Index: Integer; Jiff: Longint);
  219. begin
  220.   inherited Create;
  221.   FSeq := Index;
  222.   FJiffRate := Jiff;
  223. end;
  224.  
  225. destructor TIconFrame.Destroy;
  226. begin
  227.   if FIcon <> nil then FIcon.Free;
  228.   inherited Destroy;
  229. end;
  230.  
  231. procedure TIconFrame.Assign(Source: TPersistent);
  232. begin
  233.   if Source is TIconFrame then begin
  234.     with TIconFrame(Source) do begin
  235.       if Self.FIcon = nil then Self.FIcon := TIcon.Create;
  236.       Self.FIcon.Assign(FIcon);
  237.       Self.FIsIcon := FIsIcon;
  238.       Move(FTag, Self.FTag, SizeOf(TAniTag));
  239.       Self.FHotSpot.X := FHotSpot.X;
  240.       Self.FHotSpot.Y := FHotSpot.Y;
  241.       Self.FJiffRate := FJiffRate;
  242.       Self.FSeq := FSeq;
  243.     end;
  244.   end
  245.   else inherited Assign(Source);
  246. end;
  247.  
  248. { TAnimatedCursorImage }
  249.  
  250. constructor TAnimatedCursorImage.Create;
  251. begin
  252.   inherited Create;
  253.   FIcons := TList.Create;
  254. end;
  255.  
  256. destructor TAnimatedCursorImage.Destroy;
  257. begin
  258.   NewImage;
  259.   FIcons.Free;
  260.   inherited Destroy;
  261. end;
  262.  
  263. procedure TAnimatedCursorImage.Clear;
  264. begin
  265.   NewImage;
  266. end;
  267.  
  268. procedure TAnimatedCursorImage.NewImage;
  269. var
  270.   I: Integer;
  271. begin
  272.   for I := 0 to FIcons.Count - 1 do TIconFrame(FIcons[I]).Free;
  273.   FIcons.Clear;
  274.   FillChar(FTitle, SizeOf(FTitle), 0);
  275.   FillChar(FCreator, SizeOf(FCreator), 0);
  276.   FillChar(FHeader, SizeOf(FHeader), 0);
  277.   FOriginalColors := 0;
  278. end;
  279.  
  280. procedure TAnimatedCursorImage.RiffReadError;
  281. begin
  282.   raise EReadError.Create(ResStr(SReadError));
  283. end;
  284.  
  285. function TAnimatedCursorImage.GetTitle: string;
  286. begin
  287.   Result := StrPas(FTitle);
  288. end;
  289.  
  290. function TAnimatedCursorImage.GetCreator: string;
  291. begin
  292.   Result := StrPas(FCreator);
  293. end;
  294.  
  295. function TAnimatedCursorImage.GetIconCount: Integer;
  296. begin
  297.   Result := FIcons.Count;
  298. end;
  299.  
  300. function TAnimatedCursorImage.GetIcon(Index: Integer): TIcon;
  301. begin
  302.   Result := TIconFrame(FIcons[Index]).FIcon;
  303. end;
  304.  
  305. function TAnimatedCursorImage.GetFrame(Index: Integer): TIconFrame;
  306. begin
  307.   Result := TIconFrame(FIcons[Index]);
  308. end;
  309.  
  310. function TAnimatedCursorImage.GetDefaultRate: Longint;
  311. begin
  312.   Result := Max(0, Min((FHeader.jifRate * 100) div 6, High(Result)));
  313. end;
  314.  
  315. procedure TAnimatedCursorImage.Assign(Source: TPersistent);
  316. var
  317.   I: Integer;
  318.   Frame: TIconFrame;
  319. begin
  320.   if Source = nil then begin
  321.     Clear;
  322.   end
  323.   else if Source is TAnimatedCursorImage then begin
  324.     NewImage;
  325.     try
  326.       with TAnimatedCursorImage(Source) do begin
  327.         Move(FHeader, Self.FHeader, SizeOf(FHeader));
  328.         Self.FTitle := FTitle;
  329.         Self.FCreator := FCreator;
  330.         Self.FOriginalColors := FOriginalColors;
  331.         for I := 0 to FIcons.Count - 1 do begin
  332.           Frame := TIconFrame.Create(-1, FHeader.jifRate);
  333.           try
  334.             Frame.Assign(TIconFrame(FIcons[I]));
  335.             Self.FIcons.Add(Frame);
  336.           except
  337.             Frame.Free;
  338.             raise;
  339.           end;
  340.         end;
  341.       end;
  342.     except
  343.       NewImage;
  344.       raise;
  345.     end;
  346.   end
  347.   else inherited Assign(Source);
  348. end;
  349.  
  350. procedure TAnimatedCursorImage.AssignTo(Dest: TPersistent);
  351. var
  352.   I: Integer;
  353. begin
  354.   if Dest is TIcon then begin
  355.     if IconCount > 0 then Dest.Assign(Icons[0])
  356.     else Dest.Assign(nil);
  357.   end
  358.   else if Dest is TBitmap then begin
  359.     if IconCount > 0 then
  360.       AssignToBitmap(TBitmap(Dest), TBitmap(Dest).Canvas.Brush.Color,
  361.         True, False)
  362.     else Dest.Assign(nil);
  363.   end
  364.   else if Dest is TIconList then begin
  365.     TIconList(Dest).BeginUpdate;
  366.     try
  367.       TIconList(Dest).Clear;
  368.       for I := 0 to IconCount - 1 do TIconList(Dest).Add(Icons[I]);
  369.     finally
  370.       TIconList(Dest).EndUpdate;
  371.     end;
  372.   end
  373.   else inherited AssignTo(Dest);
  374. end;
  375.  
  376. function TAnimatedCursorImage.ReadCreateIcon(Stream: TStream; ASize: Longint;
  377.   var HotSpot: TPoint; var IsIcon: Boolean): TIcon;
  378. type
  379.   PIconRecArray = ^TIconRecArray;
  380.   TIconRecArray = array[0..300] of TIconRec;
  381. var
  382.   List: PIconRecArray;
  383.   Mem: TMemoryStream;
  384.   HeaderLen, I: Integer;
  385.   BI: PBitmapInfoHeader;
  386. begin
  387.   Result := nil;
  388.   Mem := TMemoryStream.Create;
  389.   try
  390.     Mem.SetSize(ASize);
  391.     Mem.CopyFrom(Stream, Mem.Size);
  392.     HotSpot := Point(0, 0);
  393.     IsIcon := PCursorOrIcon(Mem.Memory)^.wType = RC3_ICON;
  394.     if PCursorOrIcon(Mem.Memory)^.wType = RC3_CURSOR then
  395.       PCursorOrIcon(Mem.Memory)^.wType := RC3_ICON;
  396.     if PCursorOrIcon(Mem.Memory)^.wType = RC3_ICON then begin
  397.       { determinate original icon color }
  398.       HeaderLen := PCursorOrIcon(Mem.Memory)^.Count * SizeOf(TIconRec);
  399.       GetMem(List, HeaderLen);
  400.       try
  401.         Mem.Position := SizeOf(TCursorOrIcon);
  402.         Mem.Read(List^, HeaderLen);
  403.         for I := 0 to PCursorOrIcon(Mem.Memory)^.Count - 1 do
  404.           with List^[I] do begin
  405.             GetMem(BI, DIBSize);
  406.             try
  407.               Mem.Seek(DIBOffset, soFromBeginning);
  408.               Mem.Read(BI^, DIBSize);
  409.               FOriginalColors := Max(GetDInColors(BI^.biBitCount), FOriginalColors);
  410.               HotSpot := Point(xHotspot, yHotspot);
  411.             finally
  412.               FreeMem(BI, DIBSize)
  413.             end;
  414.           end;
  415.       finally
  416.         FreeMem(List, HeaderLen);
  417.       end;
  418.       { return to start of stream }
  419.       Mem.Position := 0;
  420.       Result := TIcon.Create;
  421.       try
  422.         Result.LoadFromStream(Mem);
  423.         if IsIcon then
  424.           HotSpot := Point(Result.Width div 2, Result.Height div 2);
  425.       except
  426.         Result.Free;
  427.         Result := nil;
  428.       end;
  429.     end;
  430.   finally
  431.     Mem.Free;
  432.   end;
  433. end;
  434.  
  435. { Loads an animatied cursor from a RIFF file. The RIFF file format for
  436.   animated cursors looks like this:
  437.  
  438.   RIFF('ACON'
  439.     LIST('INFO'
  440.           INAM(<name>)
  441.           IART(<artist>))
  442.       anih(<anihdr>)
  443.       [rate(<rateinfo>)]
  444.       ['seq '( <seq_info>)]
  445.       LIST('fram' icon(<icon_file>)))
  446. }
  447.  
  448. procedure TAnimatedCursorImage.ReadAniStream(Stream: TStream);
  449. var
  450.   iFrame, iRate, iSeq, I: Integer;
  451.   Tag: TAniTag;
  452.   Frame: TIconFrame;
  453.   cbChunk, cbRead, Temp: Longint;
  454.   Icon: TIcon;
  455.   bFound, IsIcon: Boolean;
  456.   HotSpot: TPoint;
  457. begin
  458.   iFrame := 0; iRate := 0; iSeq := 0;
  459.   { Make sure it's a RIFF ANI file }
  460.   if not ReadTag(Stream, @Tag) or (Tag.ckID <> FOURCC_RIFF) then
  461.     RiffReadError;
  462.   if (Stream.Read(Tag.ckID, SizeOf(Tag.ckID)) < SizeOf(Tag.ckID)) or
  463.     (Tag.ckID <> FOURCC_ACON) then RiffReadError;
  464.   NewImage;
  465.   { look for 'anih', 'rate', 'seq ', and 'icon' chunks }
  466.   while ReadTag(Stream, @Tag) do begin
  467.     if Tag.ckID = FOURCC_anih then begin
  468.       if not ReadChunk(Stream, @Tag, @FHeader) then Break;
  469.       if ((FHeader.fl and AF_ICON) <> AF_ICON) or
  470.         (FHeader.cFrames = 0) then RiffReadError;
  471.       for I := 0 to FHeader.cSteps - 1 do begin
  472.         Frame := TIconFrame.Create(I, FHeader.jifRate);
  473.         FIcons.Add(Frame);
  474.       end;
  475.     end
  476.     else if Tag.ckID = FOURCC_rate then begin
  477.       { If we find a rate chunk, read it into its preallocated space }
  478.       if not ReadChunkN(Stream, @Tag, @Temp, SizeOf(Longint)) then
  479.         Break;
  480.       if iRate < FIcons.Count then
  481.         TIconFrame(FIcons[iRate]).FJiffRate := Temp;
  482.       Inc(iRate);
  483.     end
  484.     else if Tag.ckID = FOURCC_seq then begin
  485.       { If we find a seq chunk, read it into its preallocated space }
  486.       if not ReadChunkN(Stream, @Tag, @Temp, SizeOf(Longint)) then
  487.         Break;
  488.       if iSeq < FIcons.Count then
  489.         TIconFrame(FIcons[iSeq]).FSeq := Temp;
  490.       Inc(iSeq);
  491.     end
  492.     else if Tag.ckID = FOURCC_LIST then begin
  493.       cbChunk := PadUp(Tag.ckSize);
  494.       { See if this list is the 'fram' list of icon chunks }
  495.       cbRead := Stream.Read(Tag.ckID, SizeOf(Tag.ckID));
  496.       if cbRead < SizeOf(Tag.ckID) then Break;
  497.       Dec(cbChunk, cbRead);
  498.       if (Tag.ckID = FOURCC_fram) then begin
  499.         while (cbChunk >= SizeOf(Tag)) do begin
  500.           if not ReadTag(Stream, @Tag) then Break;
  501.           Dec(cbChunk, SizeOf(Tag));
  502.           if (Tag.ckID = FOURCC_icon) then begin
  503.             { Ok, load the icon/cursor bits }
  504.             Icon := ReadCreateIcon(Stream, Tag.ckSize, HotSpot, IsIcon);
  505.             if Icon = nil then Break;
  506.             bFound := False;
  507.             for I := 0 to FIcons.Count - 1 do begin
  508.               if TIconFrame(FIcons[I]).FSeq = iFrame then begin
  509.                 TIconFrame(FIcons[I]).FIcon := Icon;
  510.                 TIconFrame(FIcons[I]).FTag := Tag;
  511.                 TIconFrame(FIcons[I]).FHotSpot := HotSpot;
  512.                 TIconFrame(FIcons[I]).FIsIcon := IsIcon;
  513.                 bFound := True;
  514.               end;
  515.             end;
  516.             if not bFound then begin
  517.               Frame := TIconFrame.Create(-1, FHeader.jifRate);
  518.               Frame.FIcon := Icon;
  519.               Frame.FIsIcon := IsIcon;
  520.               Frame.FTag := Tag;
  521.               Frame.FHotSpot := HotSpot;
  522.               FIcons.Add(Frame);
  523.             end;
  524.             Inc(iFrame);
  525.           end
  526.           else begin
  527.             { Unknown chunk in fram list, just ignore it }
  528.             SkipChunk(Stream, @Tag);
  529.           end;
  530.           Dec(cbChunk, PadUp(Tag.ckSize));
  531.         end;
  532.       end
  533.       else if (Tag.ckID = FOURCC_INFO) then begin
  534.         { now look for INAM and IART chunks }
  535.         while (cbChunk >= SizeOf(Tag)) do begin
  536.           if not ReadTag(Stream, @Tag) then Break;
  537.           Dec(cbChunk, SizeOf(Tag));
  538.           if Tag.ckID = FOURCC_INAM then begin
  539.             if (cbChunk < Tag.ckSize) or not
  540.               ReadChunkN(Stream, @Tag, @FTitle, SizeOf(TANINAME) - 1) then
  541.               Break;
  542.             Dec(cbChunk, PadUp(Tag.ckSize));
  543.           end
  544.           else if Tag.ckID = FOURCC_IART then begin
  545.             if (cbChunk < Tag.ckSize) or not
  546.               ReadChunkN(Stream, @Tag, @FCreator, SizeOf(TANINAME) - 1) then
  547.               Break;
  548.             Dec(cbChunk, PadUp(Tag.ckSize));
  549.           end
  550.           else begin
  551.             if not SkipChunk(Stream, @Tag) then Break;
  552.             Dec(cbChunk, PadUp(Tag.ckSize));
  553.           end;
  554.         end;
  555.       end
  556.       else begin
  557.         { Not the fram list or the INFO list. Skip the rest of this
  558.           chunk. (Don't forget that we have already skipped one dword) }
  559.         Tag.ckSize := cbChunk;
  560.         SkipChunk(Stream, @Tag);
  561.       end;
  562.     end
  563.     else begin { We're not interested in this chunk, skip it. }
  564.       if not SkipChunk(Stream, @Tag) then Break;
  565.     end;
  566.   end; { while }
  567.   { Update the frame count incase we coalesced some frames while reading
  568.     in the file. }
  569.   for I := FIcons.Count - 1 downto 0 do begin
  570.     if TIconFrame(FIcons[I]).FIcon = nil then begin
  571.       TIconFrame(FIcons[I]).Free;
  572.       FIcons.Delete(I);
  573.     end;
  574.   end;
  575.   FHeader.cFrames := FIcons.Count;
  576.   if FHeader.cFrames = 0 then RiffReadError;
  577. end;
  578.  
  579. procedure TAnimatedCursorImage.ReadStream(Size: Longint; Stream: TStream);
  580. var
  581.   Data: TMemoryStream;
  582. begin
  583.   Data := TMemoryStream.Create;
  584.   try
  585.     Data.SetSize(Size);
  586.     Stream.ReadBuffer(Data.Memory^, Size);
  587.     if Size > 0 then begin
  588.       Data.Position := 0;
  589.       ReadAniStream(Data);
  590.     end;
  591.   finally
  592.     Data.Free;
  593.   end;
  594. end;
  595.  
  596. procedure TAnimatedCursorImage.WriteStream(Stream: TStream;
  597.   WriteSize: Boolean);
  598. begin
  599.   NotImplemented;
  600. end;
  601.  
  602. procedure TAnimatedCursorImage.LoadFromStream(Stream: TStream);
  603. begin
  604.   ReadStream(Stream.Size - Stream.Position, Stream);
  605. end;
  606.  
  607. procedure TAnimatedCursorImage.SaveToStream(Stream: TStream);
  608. begin
  609.   WriteStream(Stream, False);
  610. end;
  611.  
  612. procedure TAnimatedCursorImage.LoadFromFile(const Filename: string);
  613. var
  614.   Stream: TStream;
  615. begin
  616.   Stream := TFileStream.Create(Filename, fmOpenRead + fmShareDenyNone);
  617.   try
  618.     try
  619.       LoadFromStream(Stream);
  620.     except
  621.       NewImage;
  622.       raise;
  623.     end;
  624.   finally
  625.     Stream.Free;
  626.   end;
  627. end;
  628.  
  629. procedure TAnimatedCursorImage.Draw(ACanvas: TCanvas; const ARect: TRect);
  630. begin
  631.   if FIcons.Count > 0 then
  632.     DrawRealSizeIcon(ACanvas, Icons[0], ARect.Left, ARect.Top);
  633. end;
  634.  
  635. procedure TAnimatedCursorImage.AssignToBitmap(Bitmap: TBitmap; BackColor: TColor;
  636.   DecreaseColors, Vertical: Boolean);
  637. var
  638.   I: Integer;
  639.   Temp: TBitmap;
  640. begin
  641.   Temp := TBitmap.Create;
  642.   try
  643.     if FIcons.Count > 0 then begin
  644.       with Temp do begin
  645.         Monochrome := False;
  646.         Canvas.Brush.Color := BackColor;
  647.         if Vertical then begin
  648.           Width := Icons[0].Width;
  649.           Height := Icons[0].Height * FIcons.Count;
  650.         end
  651.         else begin
  652.           Width := Icons[0].Width * FIcons.Count;
  653.           Height := Icons[0].Height;
  654.         end;
  655.         Canvas.FillRect(Bounds(0, 0, Width, Height));
  656.         for I := 0 to FIcons.Count - 1 do begin
  657.           if Icons[I] <> nil then
  658.             Canvas.Draw(Icons[I].Width * I * Ord(not Vertical),
  659.               Icons[I].Height * I * Ord(Vertical), Icons[I]);
  660.         end;
  661.       end;
  662.       if DecreaseColors then
  663.         DecreaseBMPColors(Temp, Max(OriginalColors, 16));
  664.     end;
  665.     Bitmap.Assign(Temp);
  666.   finally
  667.     Temp.Free;
  668.   end;
  669. end;
  670.  
  671. end.